home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The PC-SIG Library 10
/
The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso
/
PC_SIGCD
/
22
/
2
/
DISK2220.ZIP
/
SCREDIT4.EXE
/
VALIDATE.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1990-10-06
|
14KB
|
557 lines
Procedure S_Find_Min_and_max;
Begin
FillChar(S_CompMin,81,00);
FillChar(S_CompMax,81,00);
S_Done := False;
S_EndLine := False;
While Not S_Done Do
Begin
S_Str_Ptr := S_Str_Ptr + 1;
If S_Str_Ptr <= Length(S_CurStr) Then
Begin
If S_CurStr[S_Str_Ptr] = #94 Then
Begin
S_Str_Ptr := S_Str_Ptr + 1;
S_CompMax := S_CurStr[S_Str_Ptr]
End
Else
Begin
If S_CurStr[S_Str_Ptr] = #39 Then
Begin
If S_CompMax = '' Then
S_CompMax := S_CompMin;
S_Done := True;
End
Else
Begin
If S_CompMax = '' then
S_CompMin := S_CompMin + S_CurStr[S_Str_Ptr]
Else
S_CompMax := S_CompMax + S_CurStr[S_Str_Ptr];
End;
End;
If (S_CompMin = '\') or (S_CompMin = '=') Then
S_Done := True;
End
Else
Begin
S_Done := True;
If S_CompMin = '' Then S_EndLine := True;
End;
End;
If S_Upcase Then
Begin
S_CompMin := S_UpShiftedStr(S_CompMin);
S_CompMax := S_UpShiftedStr(S_CompMax);
End;
S_AutoHelpMsg := '';
S_EditMask := '';
S_Force_EditMask := False;
End;
Procedure S_ReadNextRangeRec;
Begin
With S_Validate^ Do
Begin
S_ValidateLine := S_NextLine;
If S_VRec <> S_NextRec Then
Begin
S_VRec := S_NextRec;
Seek(S_File,S_NextRec);
Read(S_File,S_Validate^);
End;
S_NextRec := S_RangeRec [S_ValidateLine];
S_NextLine := S_RangeLine[S_ValidateLine];
S_CurStr := S_RangeList[S_ValidateLine];
If S_InIf Then S_Str_Ptr := 4 Else S_Str_Ptr := 1;
End;
End;
Procedure S_ProcessDate;
Label S_ProcessDate_Exit;
Var
TestLen,
Error,
M_Pos,
D_Pos,
Y_Pos : Byte;
T_Month,
T_Day,
T_Year : Integer;
DateMask : String[30];
WorkNum : Integer;
Begin
Error:= 0;
M_Pos:= 0;
D_Pos:= 0;
Y_Pos:= 0;
DateMask := Copy(S_CurStr,Pos('DATE',S_CurStr)+5,Length(S_CurStr)-Pos('DATE',S_CurStr)+4);
S_Str_Ptr:= 1;
If Length(DateMask) <> Length(S_NewStr) then Error := 1;
While ((Error = 0) and (S_Str_Ptr <= Length(DateMask))) do
Begin
Case DateMask[S_Str_Ptr] of
'Y' : If Y_Pos = 0 Then
Begin
Y_Pos := S_Str_Ptr;
If DateMask[S_Str_Ptr+2] = 'Y' Then TestLen := 4 Else TestLen := 2;
Val(Copy(S_NewStr,S_Str_Ptr,TestLen),T_Year,S_Result);
If (S_Result > 0) Or (T_Year = 0) Then
Error := 2;
S_Str_Ptr := S_Str_Ptr + (TestLen - 1);
End;
'M' : If M_Pos = 0 Then
Begin
M_Pos := S_Str_Ptr;
Val(Copy(S_NewStr,S_Str_Ptr,2),T_Month,S_Result);
If (S_Result > 0) Or (T_Month = 0) Then Error := 3;
S_Str_Ptr := S_Str_Ptr + 1;
End;
'D' : If D_Pos = 0 Then
Begin
D_Pos := S_Str_Ptr;
Val(Copy(S_NewStr,S_Str_Ptr,2),T_Day,S_Result);
If (S_Result > 0) Or (T_Day = 0) Then Error := 4;
S_Str_Ptr := S_Str_Ptr + 1;
End;
Else
If S_NewStr[S_Str_Ptr] <> DateMask [S_Str_Ptr] Then Error := 1;
End;{Case of}
S_Str_Ptr := S_Str_Ptr + 1;
End;
If Error > 0 Then goto S_ProcessDate_Exit;
If (M_Pos > 0) And (Not (T_Month In [1..12])) Then
Begin
Error := 6;{Invalid Month Specified}
goto S_ProcessDate_Exit;
End;
If D_Pos > 0 Then
Begin
If M_Pos > 0 Then
Begin
If (T_Month In [1,3,5,7,8,10,12]) Then
Begin
If (T_Day > 31) Then Error := 8;
End
Else
Begin
If (T_Month <> 2) Then
Begin
If (T_Day > 30) Then Error := 9;
End
Else
Begin
If (T_Year > 0) Then
Begin
If (T_Year Mod 4) <> 0 Then
Begin
If (T_Day > 28) Then Error := 10
End
Else
If (T_Day > 29) Then Error := 11;
End
Else
If T_Day > 29 Then Error := 11;
End;
End;
End
Else
If T_Day > 31 Then Error := 12;
End;
S_ProcessDate_Exit:
If Error > 0 Then
Begin
S_ScreenValid := False;
Case Error Of
1 : S_ErrorMsg := 'Please enter date in ' + DateMask + ' format.';
2 : S_ErrorMsg := 'Year contains invalid charcter.';
3 : S_ErrorMsg := 'Month contains invalid character.';
4 : S_ErrorMsg := 'Day of date contains invalid character.';
6 : S_ErrorMsg := 'Month must be 1 thru 12.';
8 : S_ErrorMsg := 'Only 31 Days in this month.';
9 : S_ErrorMsg := 'Only 30 Days in this month.';
10: S_ErrorMsg := 'February only has 28 days.';
11: S_ErrorMsg := 'February only has 29 days.';
12: S_ErrorMsg := 'Day can never exceed 31';
End;
End;
End;
Procedure S_ProcessIN;
Begin
S_EndLine:= True;
S_Matched:= False;
S_Str_Ptr:= Pos('IN',S_CurStr)+3;
S_CompMin[1]:= #32;
S_EditStr:= S_NewStr;
If S_Upcase Then
S_EditStr := S_UpShiftedStr(S_EditStr);
While Not((S_Matched) or (S_CompMin[1] IN ['\','='])) Do
Begin
S_Find_Min_and_max;
If (S_CompMin <> '\')And(S_CompMin <> '=')And(Not S_EndLine) Then
Begin
S_GetFieldType(S_Field^.S_Type[S_Point]);
If (S_FType In [0..7]) Then
Begin
S_Numeric := 0;
S_CompMin_Numeric := 0;
S_CompMax_Numeric := 0;
Val(S_EditStr,S_Numeric,S_Result);
Val(S_CompMin,S_CompMin_Numeric,S_Result);
Val(S_CompMax,S_CompMax_Numeric,S_Result);
If (S_Numeric >= S_CompMin_Numeric) And
(S_Numeric <= S_CompMax_Numeric) Then
S_Matched := True;
End
Else
Begin
If (S_EditStr >= S_CompMin) And (S_EditStr <= S_CompMax) Then
S_Matched := True;
End;
End;
If S_EndLine Then
Begin
S_EndLine := False;
S_ReadNextRangeRec;
S_Str_Ptr := S_Str_Ptr - 1;
Repeat
S_Str_Ptr := S_Str_Ptr + 1;
Until S_CurStr[S_Str_Ptr] IN [#39,'\','='];
If S_CurStr[S_Str_Ptr] <> #39 Then
S_CompMin := S_CurStr[S_Str_Ptr];
End;
End;
If S_Matched Then
Begin
While Not(S_CurStr[S_Str_Ptr] In ['\','=']) Do
Begin
S_Str_Ptr := Pos('\',S_CurStr);
If S_Str_Ptr = 0 Then S_Str_Ptr := Pos('=',S_CurStr);
If S_Str_Ptr = 0 Then
Begin
S_ReadNextRangeRec;
S_Str_Ptr := 1;
End;
End;
If S_CurStr[S_Str_Ptr] = '=' then
Begin
S_ScreenValid := False;
S_ErrorMsg:= Copy(S_CurStr,(S_Str_Ptr+1),Length(S_CurStr));
End
Else
S_Matched := False;
End
Else
Begin
If S_CurStr[S_Str_Ptr] = '\' then
Begin
S_ScreenValid := False;
S_ErrorMsg:= Copy(S_CurStr,(S_Str_Ptr+1),Length(S_CurStr));
End
End;
End;
Procedure S_ProcessIf;
Var
End_Loop,Or_Found,NOT_Found,THEN_Found : Boolean;
CompField : String[16];
Begin
S_CompMin:= '';
S_CompMax:= '';
S_Matched:= FALSE;
S_WorkStr:= S_EditStr;
THEN_Found:= False;
S_Skip:= False;
While Not Then_Found do
Begin
If Pos('NOT ',S_CurStr) = 4 Then
Begin
S_Str_Ptr:= 8;
NOT_Found:= True;
End
Else
Begin
S_Str_Ptr:= 4;
NOT_Found:= False;
End;
CompField:= '';
While S_CurStr[S_Str_Ptr] <> #39 Do
Begin
CompField:= CompField + UpCase(S_CurStr[S_Str_Ptr]);
S_Str_Ptr:= S_Str_Ptr + 1;
End;
S_FieldNo := 1;
S_Matched := False;
End_Loop := False;
While CompField <> S_UpShiftedStr(S_Field^.S_FieldName [S_FieldNo])Do
Begin
S_FieldNo := S_FieldNo + 1;
If S_FieldNo > S_Indx^.S_Count[S_Num] Then
Begin
S_FieldNo := 1;
End_Loop := True;
CompField := '';
S_Field^.S_FieldName[1]:='';
End;
End;
S_Get_Field_Value(S_FieldNo);
S_EditStr := S_TruncateStr(S_EditStr);
If S_Upcase Then S_EditStr := S_UpShiftedStr(S_EditStr);
S_Matched:= False;
End_Loop := False;
While Not End_Loop do
Begin
Repeat
S_Find_Min_and_Max;
If S_EndLine Then
Begin
S_ReadNextRangeRec;
S_Str_Ptr := Pos(Chr(39),S_CurStr);
End;
Until Not(S_EndLine);
If ((S_CompMin='THEN') Or (S_CompMin='OR') Or (S_CompMin='AND')) Then
End_Loop := True;
If Not((End_Loop) Or (S_Matched)) Then
Begin
S_GetFieldType(S_Field^.S_Type [S_FieldNo]);
If (S_FType In [0..7]) Then
Begin
S_Numeric := 0;
S_CompMin_Numeric := 0;
S_CompMax_Numeric := 0;
Val(S_EditStr,S_Numeric,S_Result);
Val(S_CompMin,S_CompMin_Numeric,S_Result);
Val(S_CompMax,S_CompMax_Numeric,S_Result);
If Not_Found Then
Begin
If (S_Numeric < S_CompMin_Numeric) Or
(S_Numeric > S_CompMax_Numeric) Then
S_Matched := True
End
Else
Begin
If (S_Numeric >= S_CompMin_Numeric) And
(S_Numeric <= S_CompMax_Numeric) Then
S_Matched := True;
End;
End
Else
Begin
If Not_Found Then
Begin
If (S_EditStr < S_CompMin) Or (S_EditStr > S_CompMax) Then
S_Matched := True
End
Else
Begin
If (S_EditStr >= S_CompMin) And (S_EditStr <= S_CompMax) Then
S_Matched := True;
End;
End;
End;
End;
If S_CompMin = 'AND' Then
Begin
If Not S_Matched Then
Begin
Repeat
S_ReadNextRangeRec;
Until ((Pos('THEN',S_CurStr) = Length(S_CurStr)-3) Or
(Pos('OR',S_CurStr) = Length(S_CurStr)-1));
If (Pos('OR',S_CurStr) = Length(S_CurStr)-1) Then S_CompMin := 'OR';
If (Pos('THEN',S_CurStr) = Length(S_CurStr)-3) Then Then_Found := True;
End
Else
S_ReadNextRangeRec;
End;
If S_CompMin = 'OR' Then
Begin
If S_Matched Then
Repeat
S_ReadNextRangeRec;
If (Pos('THEN',S_CurStr) = Length(S_CurStr)-3) Then Then_Found := True;
Until Then_Found
Else
S_ReadNextRangeRec;
End;
If S_CompMin = 'THEN' Then Then_Found := True;
End;
If S_Matched Then
Begin
S_Matched := False;
While S_CurStr <> 'ENDIF' Do
Begin
S_ReadNextRangeRec;
If (Pos('ERROR',S_CurStr) = 4) Then
Begin
S_ScreenValid := False;
S_ErrorMsg := Copy(S_CurStr,9,Length(S_CurStr));
End;
If (Pos('DATE',S_CurStr) = 4) Then S_ProcessDate;
If S_CurStr = ' SKIP' Then S_Skip := True;
If (Pos('IN',S_CurStr) = 4) Then
Begin
S_Str_Ptr := 4;
S_InIf := True;
S_ProcessIn;
S_InIf := False;
End;
If (S_ScreenValid = False) Or (S_Skip) Then
While S_CurStr <> 'ENDIF' Do S_ReadNextRangeRec
End;
End
Else
While S_CurStr <> 'ENDIF' Do S_ReadNextRangeRec;
S_EditStr := S_WorkStr;
End;
Procedure S_Validate_Location;
Var
WorkStr : String[1];
Begin
S_Upcase:= False;
S_ScreenValid:= True;
S_WorkStr:= '';
S_Skip:= False;
With S_Validate^ do
Begin
While ((S_NextRec > 0) And (S_ScreenValid)) And (Not S_Skip) Do
Begin
S_ReadNextRangeRec;
If (S_CurStr[1] = 'I') Then
If S_CurStr[2] = 'F' Then S_ProcessIf Else S_ProcessIN;
If S_CurStr [1] = 'U' Then
Begin
If S_CurStr[11] = 'N' Then
Begin
S_Upcase := True;
S_EditStr := S_UpShiftedStr(S_EditStr);
End
Else
Begin
S_Upcase := False;
S_EditStr := S_NewStr;
End;
End;
If (S_CurStr[1] = 'S') And (S_CurStr[2] = 'K') And (S_EditStr = '') Then
S_NextRec := 0;
If (S_CurStr[3] = 'Q') Then {Required}
Begin
If S_EditStr = '' Then
Begin
WorkStr[0] := #01;
WorkStr[1] := #39;
S_Str_Ptr := Pos(WorkStr,S_CurStr);
S_ScreenValid := False;
If S_Str_Ptr = 0 Then
S_ErrorMsg := 'This field is required'
Else
S_ErrorMsg := Copy(S_CurStr,(S_Str_Ptr+1),Length(S_CurStr)-S_Str_Ptr);
End;
End;
If S_CurStr[1] = 'D' Then S_ProcessDate;
End;
End;
End;
Procedure S_ValidateScreen;
Begin
If S_ValidateField > 0 Then S_Point := S_ValidateField Else S_Point := 1;
S_RecNo := 9999;
S_ScreenValid := True;
S_VDone := False;
{*** Changed ***}
S_FieldCounter := 0;
{*** Changes End ***}
While ((S_Point <= S_Indx^.S_Count[S_Num]) And (S_VDone = False)) Do
Begin
While (S_Field^.S_Type [S_Point] > 9) And
(S_FieldCounter <= S_Indx^.S_Count[S_Num]) do
Begin
S_FieldCounter := S_FieldCounter + 1;
S_Point := S_Field^.S_Next [S_Point];
End;
If S_Point <= S_Indx^.S_Count[S_Num] then
Begin
S_Get_Field_Value(S_Point);
S_EditStr := S_TruncateStr(S_EditStr);
S_NewStr := S_EditStr;
S_NextRec := S_Field^.S_RangeNextRec [S_Point];
S_NextLine := S_Field^.S_RangeNextLine [S_Point];
S_Validate_Location;
If S_ScreenValid Then
Begin
If S_ValidateField > 0 then
S_VDone := True
Else
S_Point := S_Point + 1;
End
Else
S_VDone := True;
End
Else
S_VDone := True;
End;
If S_ScreenValid Then
S_Point := S_PrevFld
Else
If S_IsDupe(S_Point) Then S_SetDupeFields := True;
End;
